'Dynamiko to ftoxo frixto eee? :)
'$DYNAMIC

REM ------------------------------------
REM ------- Project "INFOFREAK" --------
REM ----- A demo by Michael Kargas -----
REM ------------------------------------

REM At least that was the name of it when I was first working on, in a very
REM old time at a far away galaxy! :) Even before The Poor Freak anyways.. ;)
REM But these are very early code of mine which were left totally as they are
REM untouched. Oneday I found them and I decided to release them in the wild
REM demo compo of ReAct. Just so, to have at least one silly contribution,
REM rather than nothing at all. It's at least 3 years old code,. it was very
REM funny to try to read it and have some laugh on how lame it was! =)
REM Actually I have made few changes, and the beginning writer and roto is
REM not from the old sources, but not that new code too..
REM Now this is something like a prequel of The Poor Freak demo ;)
REM Let's call it "Project Infofreak aka TPF prequel" :)
REM --> More in nfo file
REM
REM ========================================================================
REM =========- Michael Kargas aka Optimus/Dirty Minds/Nasty Bugs -==========
REM ======-=- mkargas@hotmail.com -=- http://users.auth.gr/mkargas -=-======
REM ========================================================================


REM ***********  MAIN SUBS  ************


DECLARE SUB pal (a$, w, r(), g(), b())
DECLARE SUB pal0 (a$)
DECLARE SUB img (a$, c)
DECLARE SUB fontload (a$)
DECLARE SUB fontget (xg, yg, l, lt%())
DECLARE SUB text (a$, xf, yf)
DECLARE SUB onebitfontload (a$)
DECLARE SUB palget (r(), g(), b())
DECLARE SUB fadetocolor (a, c, t, r, g, b)
DECLARE SUB fadefromcolor (a, c, t, r, g, b)
DECLARE SUB fadetocolorscale (a, c, t, r, g, b)
DECLARE SUB fadefromcolorscale (a, c, t, r, g, b)
DECLARE SUB gradientx (xa, ya, xb, yb, ca, cb)
DECLARE SUB gradienty (xa, ya, xb, yb, ca, cb)
DECLARE SUB fill (xa, ya, xb, yb, ca, cb, a, b, c, k, l, m)
DECLARE SUB ldiload (a$)
DECLARE SUB fill2 (xa, ya, xb, yb, a, b, c)

REM --------------------------------------

DECLARE SUB fadefromcolor2 (a, c, t, r, g, b)

SCREEN 13

DIM SHARED r(255), g(255), b(255)
DIM nr(255), ng(255), nb(255)
palget r(), g(), b()
DIM thamasvgeiodiasr(255), thamasvgeiodiasg(255), thamasvgeiodiasb(255)

'GOTO 1112

FOR i% = 0 TO 255
thamasvgeiodiasr(i%) = r(i%)
thamasvgeiodiasg(i%) = g(i%)
thamasvgeiodiasb(i%) = b(i%)
NEXT i%

DIM SHARED fc%(1149)

'OUT &H3C8, 15
'OUT &H3C9, 0
'OUT &H3C9, 0
'OUT &H3C9, 0

onebitfontload "tinyfont.fnt"

i% = 0
FOR c% = 0 TO 44
FOR y% = 0 TO 4
FOR x% = 0 TO 4
fc%(i%) = POINT(x% + c% * 5, y%)
i% = i% + 1
NEXT x%
NEXT y%
NEXT c%
' To xero oti eimai trelos, den xreiazete na mou to peite. To xero oti eimai paraxenos. Den tolmo na theoriso ta pragmata kala i kaka. that's the way I am. Kala i kaka einai allithina, einai mesa mou. Etsi kai allios tha synexiso. Oti nane grafo damn..
' gmt, teliose kai to line buffer ;P

xsxs% = 16000
DIM s%(xsxs%)

CLS
REM ------------ New code Writer 0 -------------

wx% = 0: wy% = 0: wl% = 0: txxt% = 0
wfr% = 1

DIM txt$(59)

txt$(0) = "this must be my contribution to"
txt$(1) = "   react wild compo..          "
txt$(2) = " got the idea when i found some"
txt$(3) = " very old sources of mine done "
txt$(4) = " in quickbasic and decided to  "
txt$(5) = " release just any crap for the "
txt$(6) = " party in order to release a   "
txt$(7) = " part of my mind from my whole "
txt$(8) = " stressed deadline..           "
txt$(9) = "                               "
txt$(10) = "actually the code which will   "
txt$(11) = "follow is my old 1st qb stuff  "
txt$(12) = " something like the prequel of "
txt$(13) = "          the poor freak demo@)"
txt$(14) = " it was called at that time    "
txt$(15) = "          the project infofreak"


txt$(16) = "i decided to tire you just with"
txt$(17) = "one more page of text @)       "
txt$(18) = "i know that all the people here"
txt$(19) = "in react wouldnt feel very well"
txt$(20) = "watching something like the    "
txt$(21) = "itfdemo toingtoing writer for  "
txt$(22) = "a long time @) (hey, but the   "
txt$(23) = "rules in react page said that  "
txt$(24) = "there is no time limit at all!)"
txt$(25) = "..... the title and idea of it "
txt$(26) = "behind the old demo is strange "
txt$(27) = "remembrance for me, but why    "
txt$(28) = "should i write you about my    "
txt$(29) = "silly thoughts and my life? in "
txt$(30) = "fact there is hardly any space "
txt$(31) = "left, so i 'll take 1 more page"

txt$(32) = "..... what was i before???....."
txt$(33) = " before the project infofreak  "
txt$(34) = " what is that? it sounds silly!"
txt$(35) = " funny.i have even found myself"
txt$(36) = " laughing with my strange self "
txt$(37) = "            and after?         "
txt$(38) = " the poor freak (i am not that "
txt$(39) = "poor anymore i said oneday @)  "
txt$(40) = "    then into the fight (what  "
txt$(41) = "fight? what the hell are you   "
txt$(42) = "talking about?!?!?! arghh! @p) "
txt$(43) = "  1234567890 6128 6502 16777216"
txt$(44) = " what comes next..? @) @) @) @)"
txt$(45) = "@@@@anyways. i think i 'll let "
txt$(46) = "you watch old code now and let "
txt$(47) = "you in peace (more in nfo file)"



REM --- RotoZoom! ---

SCREEN 13
OUT &H3D4, 9
OUT &H3D5, 3


DIM mul92%(0 TO 100)
FOR i% = 0 TO 100
mul92%(i%) = i% * 92
NEXT i%

p$ = "optimus.pal": f$ = "optimus.spr"
n% = 0

pal0 p$
palget r(), g(), b()

a$ = " "
p% = 0

OPEN f$ FOR BINARY AS #1
GET #1, 1, a$
xg% = ASC(a$)
GET #1, 2, a$
yg% = ASC(a$)

DIM c%(9200)

SEEK #1, 3
FOR p% = 1 TO 9200
GET #1, , a$
c%(p%) = ASC(a$)
NEXT p%
CLOSE

COLOR 192

DIM xopen%(100), xclose%(100)
FOR y% = -50 TO 49
xo% = 0: eps% = 0
FOR x% = -80 TO 79
IF SQR(x% ^ 2 + y% ^ 2) < 47 AND xo% = 0 THEN xo% = 1: xopen%(y% + 50) = x% + 80: eps% = 1
IF SQR(x% ^ 2 + y% ^ 2) > 47 AND xo% = 1 THEN xo% = 0: xclose%(y% + 50) = x% + 80
NEXT x%
IF eps% = 0 THEN xopen%(y% + 50) = 255: xclose%(y% + 50) = 255
NEXT y%


REM +++++++++++++++++++++++++

y1% = 50: y2% = 150
xg2% = xg% \ 2: yg2% = yg% \ 2

DEF SEG = &HA000

k% = 0
DO WHILE INKEY$ = ""
k% = k% + 1

fcos = COS(k% / 75)
fsin = SIN(k% / 75)

yc = (y1% - 100) * fcos: ys = (y1% - 100) * fsin
yp% = 0: yd% = 0

FOR y% = 0 TO 99
IF xopen%(y%) = 255 THEN GOTO 4321

xc = (xopen%(y%) - 80) * fcos: xs = (xopen%(y%) - 80) * fsin
FOR x% = xopen%(y%) TO xclose%(y%)

xt% = xc - ys + xg2%
yt% = xs + yc + yg2%

IF s%(yd% + x%) <> 255 THEN s%(yd% + x%) = c%(mul92%(yt%) + xt%)

xc = xc + fcos: xs = xs + fsin
NEXT x%
4321
yc = yc + fcos: ys = ys + fsin
yd% = yd% + 160
NEXT y%


nlt% = nlt% + 1
IF nlt% MOD 4 <> 0 THEN GOTO 5435
wl% = wl% + 1
IF wl% > 31 * 16 THEN GOTO 5435


' -------- writer here ------------

'27 !( :- ) ',.1234567890

wt$ = MID$(txt$(wy%), wx% + 1, 1)
txxt% = ASC(wt$) - 97
IF wt$ = " " THEN txxt% = 43
IF wt$ = "!" THEN txxt% = 26
IF wt$ = "(" THEN txxt% = 27
IF wt$ = "@" THEN txxt% = 28
IF wt$ = ")" THEN txxt% = 29
IF wt$ = "'" THEN txxt% = 30
IF wt$ = "," THEN txxt% = 31
IF wt$ = "." THEN txxt% = 32
IF wt$ = "?" THEN txxt% = 44
IF wt$ = "0" THEN txxt% = 42
IF wt$ >= "1" AND wt$ <= "9" THEN txxt% = 33 + ASC(wt$) - 49
fl% = txxt% * 25

' Olo malakies eimai

OUT &H3C8, 255
OUT &H3C9, 63
OUT &H3C9, 63
OUT &H3C9, 63


i% = 0
FOR y% = 0 TO 4
FOR x% = 0 TO 4
psp% = (wy% MOD 16) * 960 + wx% * 5 + y% * 160 + x%
IF fc%(fl% + i%) <> 0 THEN s%(psp%) = fc%(fl% + i%)
i% = i% + 1
NEXT x%
NEXT y%


wx% = wx% + 1: IF wx% > 30 THEN wx% = 0: wy% = wy% + 1



5435
IF wl% > 31 * 16 + 62 THEN wl% = 0: sql% = sql% + 1: ERASE s%: REDIM s%(16000)
IF sql% = 3 THEN GOTO 030310317337

WAIT &H3DA, 8: WAIT &H3DA, 8, 8


ss% = 0
FOR s% = 0 TO 15999
ss% = ss% + 2
POKE ss%, s%(s%): POKE ss% + 1, s%(s%)
NEXT s%

LOOP

030310317337
SLEEP 3
fadetocolor 0, 255, 140, 0, 0, 0
CLS


OUT &H3D4, 9
OUT &H3D5, 1


FOR i% = 0 TO 255
OUT &H3C8, i%
OUT &H3C9, thamasvgeiodiasr(i%)
OUT &H3C9, thamasvgeiodiasg(i%)
OUT &H3C9, thamasvgeiodiasb(i%)
r(i%) = thamasvgeiodiasr(i%)
g(i%) = thamasvgeiodiasr(i%)
b(i%) = thamasvgeiodiasr(i%)
NEXT i%

REM --------------------------------------------


'GOTO 1112
COLOR 15

pal "intro.pal", 0, r(), g(), b()

FOR k = 0 TO 50
OUT &H3C7, k
nr(k) = INP(&H3C9)
ng(k) = INP(&H3C9)
nb(k) = INP(&H3C9)
NEXT k

'GOTO 129

SLEEP 1
fadetocolor 15, 15, 1, 0, 0, 0
LOCATE 12, 13: PRINT "MICHAEL KARGAS": GOSUB 127
LOCATE 12, 14: PRINT "aka APETISIS": GOSUB 127
LOCATE 12, 6: PRINT "or OPTIMUS of DIRTY MINDS(CPC)": GOSUB 127
SLEEP 2
' Sas exo miliseo pote gia tous perifimous nomous tis malakias!?
LOCATE 12, 17: PRINT "presents": GOSUB 127
LOCATE 12, 13: PRINT "his first demo": GOSUB 127
SLEEP 3
LINE (95, 80)-(210, 103), 15, B
LINE (94, 79)-(211, 104), 15, B
LOCATE 12, 15: PRINT "in Q-basic!": GOSUB 127
' How 'bout opening the Fortran demoscene?
SLEEP 1
LOCATE 12, 18: PRINT "called": GOSUB 127
GOTO 128
127
fadefromcolor 15, 15, 70, 0, 0, 0
SLEEP 3
fadetocolor 15, 15, 70, 0, 0, 0
CLS
RETURN
128
129


fadefromcolor 0, 255, 50, 0, 0, 0


FOR i% = 0 TO 255
OUT &H3C8, i%
'OUT &H3C9, r(i%)
'OUT &H3C9, g(i%)
'OUT &H3C9, b(i%)

OUT &H3C9, thamasvgeiodiasr(i%)
OUT &H3C9, thamasvgeiodiasg(i%)
OUT &H3C9, thamasvgeiodiasb(i%)
r(i%) = thamasvgeiodiasr(i%)
g(i%) = thamasvgeiodiasr(i%)
b(i%) = thamasvgeiodiasr(i%)
NEXT i%

FOR m = 0 TO 15
OUT &H3C8, m
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0
NEXT m
FOR m = 16 TO 22
OUT &H3C8, m
OUT &H3C9, (m - 15) * 9
OUT &H3C9, (m - 15) * 9
OUT &H3C9, (m - 15) * 9
NEXT m
FOR m = 23 TO 29
OUT &H3C8, m
OUT &H3C9, (30 - m) * 9
OUT &H3C9, (30 - m) * 9
OUT &H3C9, (30 - m) * 9
NEXT m
FOR m = 30 TO 50
OUT &H3C8, m
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0
NEXT m
palget r(), g(), b()

' menus beelong in restaurant someone said. I will burn another text though:
' real code is unreadable. It's not intended for a user to change it, it's not a custom thing to change values upon it. It's just one special piece of text that only the coder of it could possibly understand it... ;)

ytrewq% = 1
onebitfontload "font.fnt"
xf = xg / l
yf = yg
DIM SHARED lt%(((xf * yf) \ 2 + 3) * l)
fontget xg, yg, l, lt%()
CLS
DIM c(112, 29)
text "                     PROJECT", xf, yf
FOR y = 17 TO 29
FOR x = 22 TO 112
c(x, y) = POINT(x, y)
NEXT x
NEXT y
xg = 112
yg = 11

xd = 140
yd = 60
cn = xg / 2
cnn = yg * 2
k = 2



FOR y = 17 TO 29
FOR x = 22 TO 112
LINE ((x * k - k) - cn * k + xd, (y * k - k) - cnn * k + yd)-((x * k) - cn * k + xd, (y * k) - cnn * k + yd), c(x, y), BF
'I am even pissed of myself for feeling arrogant,bad or something. Confused entity, 2 in 1. Life is interesting afteralls...
NEXT x
NEXT y
text "                     INFOFREAK", xf, yf

DIM cc(144, 29)
FOR y = 17 TO 29
FOR x = 22 TO 144
cc(x, y) = POINT(x, y)
NEXT x
NEXT y

xd = 100
yd = 120
cn = xg / 2
cnn = yg * 2
k = 2.5

COLOR 64

FOR y = 17 TO 29
FOR x = 22 TO 144
LINE ((x * k - k) - cn * k + xd, (y * k - k) - cnn * k + yd)-((x * k) - cn * k + xd, (y * k) - cnn * k + yd), cc(x, y), BF
NEXT x
NEXT y
LINE (1, 1)-(144, 37), 0, BF

FOR y = 47 TO 75
FOR x = 67 TO 248
IF POINT(x, y) = 255 THEN PSET (x, y), y + 23
NEXT x
NEXT y
FOR y = 100 TO 140
FOR x = 16 TO 300
IF POINT(x, y) = 255 THEN PSET (x, y), (x + y) / 15 + 5
NEXT x
NEXT y
k = 1
n = 1
'And the quote of Antitec: It isn't a good idea to allow more than one person use the same computer. If so then the system is fucked up! That's why they call them "Personal" computers ;)
'WHILE a$ = ""
'a$ = INKEY$



FOR jjjj% = 1 TO 700

s = s + k
IF s = 92 THEN k = -1
IF s = 0 THEN k = 1
FOR l = 70 TO 98
OUT &H3C8, l
OUT &H3C9, r(l + s)
OUT &H3C9, g(l + s)
OUT &H3C9, b(l + s)
NEXT l

t = t + n
IF t = 15 THEN n = -1
IF t = -13 THEN n = 1
FOR m = 13 TO 35
OUT &H3C8, m
OUT &H3C9, r(m + t)
OUT &H3C9, g(m + t)
OUT &H3C9, b(m + t)
NEXT m

WAIT &H3DA, 8: WAIT &H3DA, 8, 8
NEXT jjjj%

FOR x = 1 TO 320 STEP 2
LINE (x, 0)-(x, 200), 0
LINE (319 - x, 0)-(319 - x, 200), 0
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
NEXT x


FOR l = 0 TO 50
OUT &H3C8, l
OUT &H3C9, nr(l)
OUT &H3C9, ng(l)
OUT &H3C9, nb(l)
NEXT l




1112
RANDOMIZE TIMER
kkk% = 14447
DIM b0%(kkk%)
pal "intro.pal", 0, r(), g(), b()
palget r(), g(), b()
fadetocolor 0, 255, 1, 0, 0, 0



DIM fr(255), fg(255), fb(255)


SCREEN 13










gradientx 0, 0, 320, 200, 120, 70

GET (1, 1)-(319, 90), b0%



FOR s = 1 TO 100
y = INT(RND * 50)
PSET (RND * 320, y), (121 + y \ 10)
NEXT s

FOR s = 1 TO 20
y = INT(RND * 40 + 50)
PSET (RND * 100, y), (121 + y \ 10)
PSET (RND * 145 + 175, y), (121 + y \ 10)
NEXT s
s = 0


CIRCLE (160, 500), 400, 2
PAINT (160, 190), 10, 2

ldiload "intro.ldi"
fill 140, 140, 156, 145, 50, 64, 0, 0, 0, 1, 1, 0
fill 157, 140, 177, 145, 64, 50, 0, 0, 0, 1, 1, 0
PAINT (195, 123), 201, 3
fill 186, 106, 225, 170, 50, 64, 0, 0, 0, 1, 1, 200
fill 187, 121, 199, 126, 64, 50, 0, 0, 0, 2, 1, 201
' You can say that these rem messages inside my paleolithic crapy code are something like easter eggs for freaks ;)



DIM b1%(100), b2%(87), b3%(398)
DIM SHARED b4%(839)

GET (125, 103)-(139, 115), b1%
GET (163, 106)-(172, 122), b2% 'de gamite kai o dias leo go..
GET (173, 99)-(208, 120), b3%
GET (163, 92)-(216, 122), b4%

DIM SHARED ax1%(100), ax2%(100), ax3%(100)

DIM SHARED dx1%(87), dx2%(87)

DIM SHARED mn1%(398), mn2%(398), mn3%(398), mn4%(398)

DIM SHARED dx01%(839), dx02%(839), dx03%(839), dx04%(839), dxm1%(839), dxm2%(839), dxm3%(839)


ldiload "axeri1.ldi"
GET (125, 103)-(139, 115), ax1%
PUT (125, 103), b1%, PSET
ldiload "axeri2.ldi"
GET (125, 103)-(139, 115), ax2%
PUT (125, 103), b1%, PSET
ldiload "axeri3.ldi"
GET (125, 103)-(139, 115), ax3%

ldiload "dxeri1.ldi"
GET (163, 106)-(172, 122), dx1%
PUT (163, 106), b2%, PSET
ldiload "dxeri2.ldi"
GET (163, 106)-(172, 122), dx2%
PUT (163, 106), b2%, PSET
                       
ldiload "mouse1.ldi"
GET (173, 99)-(208, 120), mn1%
PUT (173, 99), b3%, PSET
ldiload "mouse2.ldi"
GET (173, 99)-(208, 120), mn2%
PUT (173, 99), b3%, PSET
ldiload "mouse3.ldi"
GET (173, 99)-(208, 120), mn3%
PUT (173, 99), b3%, PSET
ldiload "mouse4.ldi"
GET (173, 99)-(208, 120), mn4%
PUT (173, 99), b3%, PSET

REM ------------

ldiload "dx1.ldi"
GET (163, 92)-(216, 122), dx01%
PUT (163, 92), b4%, PSET
ldiload "dx2.ldi"
GET (163, 92)-(216, 122), dx02%
PUT (163, 92), b4%, PSET
ldiload "dx3.ldi"
GET (163, 92)-(216, 122), dx03%
PUT (163, 92), b4%, PSET
ldiload "dxm1.ldi"
GET (163, 92)-(216, 122), dx04%
PUT (163, 92), b4%, PSET

REM --------

ldiload "dxsm1.ldi"
GET (163, 92)-(216, 122), dxm1%
PUT (163, 92), b4%, PSET
ldiload "dxsm2.ldi"
GET (163, 92)-(216, 122), dxm2%
PUT (163, 92), b4%, PSET
ldiload "dxsm3.ldi"
GET (163, 92)-(216, 122), dxm3%
PUT (163, 92), b4%, PSET


fadefromcolor 0, 255, 100, 0, 0, 0


REM -------------

DO

palget r(), g(), b()

FOR k = 1 TO 50

FOR c = 70 TO 120 - k
OUT &H3C8, c
OUT &H3C9, r(c + k)
OUT &H3C9, g(c + k)
OUT &H3C9, b(c + k)
NEXT c

s = s + 1
FOR l = 1 TO 69
OUT &H3C8, l
OUT &H3C9, r(l) + s * ((0 - r(l)) / 52)
OUT &H3C9, g(l) + s * ((0 - g(l)) / 52)
OUT &H3C9, b(l) + s * ((0 - b(l)) / 52)
NEXT l

FOR l = 121 TO 130

OUT &H3C8, l
OUT &H3C9, r(l) + s * ((63 - r(l)) / 52)
OUT &H3C9, g(l) + s * ((63 - g(l)) / 52)
OUT &H3C9, b(l) + s * ((63 - b(l)) / 52)
NEXT l


FOR l = 150 TO 160
OUT &H3C8, l
OUT &H3C9, INT(RND * 63)
OUT &H3C9, INT(RND * 63)
OUT &H3C9, INT(RND * 63)
NEXT l




a = INT(RND * 5)
IF a <= 2 THEN PUT (125, 103), ax1%, PSET
IF a > 2 AND a <= 4 THEN PUT (125, 103), ax2%, PSET
IF a = 5 THEN PUT (125, 103), ax3%, PSET

IF rm = 2 AND mc = 5 THEN GOTO 32
IF rm = 1 OR sm = 1 OR rm = 2 AND mc <> 5 THEN GOTO 33
d = INT(RND * 5)
IF d <= 3 THEN PUT (163, 106), dx1%, PSET
IF d > 3 AND d <= 5 THEN PUT (163, 106), dx2%, PSET
ms = INT(RND * 10)

IF ms <= 3 THEN PUT (173, 99), mn1%, PSET
IF ms > 3 AND ms <= 5 THEN PUT (173, 99), mn2%, PSET
IF ms > 5 AND ms <= 7 THEN PUT (173, 99), mn3%, PSET
IF ms > 7 THEN PUT (173, 99), mn4%, PSET
GOTO 33

32
um = INT(RND * 16)

IF um <= 4 THEN PUT (163, 92), dxm1%, PSET
IF um > 4 AND um <= 8 THEN PUT (163, 92), dxm2%, PSET
IF um > 8 AND um <= 12 THEN PUT (163, 92), dxm3%, PSET


33
REM ================ mouse ===================

IF rm = 1 THEN GOTO 31
IF sm = 1 THEN GOTO 30
rm = INT(RND * 10)
IF rm = 1 AND mc <> 5 THEN mc = 1
IF rm = 1 AND mc = 5 THEN sm = 1: rm = 0: mc = 6: PUT (163, 92), b4%, PSET
30
IF sm = 1 THEN mc = mc - 2
IF sm = 1 AND mc = 0 THEN sm = 0: rm = 0: PUT (163, 92), b4%, PSET



' Ok,. I am getting mad now with these easter egg remlines inside!!! =)
31
IF mc = 4 THEN PUT (163, 92), dx04%, PSET: mc = mc + 1
IF mc = 3 THEN PUT (163, 92), dx03%, PSET: mc = mc + 1
IF mc = 2 THEN PUT (163, 92), dx02%, PSET: mc = mc + 1
IF mc = 1 THEN PUT (163, 92), dx01%, PSET: mc = mc + 1
IF mc = 5 THEN rm = 2


WHILE INKEY$ <> "": END: WEND
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
NEXT k

IF asd% = 1 THEN COLOR 67: LOCATE 23, 12: PRINT "That's all folks!"

fadetocolor 70, 120, 1, 0, 0, 0

pal "intro2.pal", 1, r(), g(), b()


REM ----------------------------

fadefromcolor2 70, 120, 500, 0, 0, 0
FOR k = 0 TO 255
fr(k) = r(k)
fg(k) = g(k)
fb(k) = b(k)
NEXT k



FOR k = 70 TO 120
OUT &H3C7, k
r(k) = INP(&H3C9)
g(k) = INP(&H3C9)
b(k) = INP(&H3C9)
NEXT k


REM ---------------------
fadetocolor 70, 130, 1000, 0, 0, 63



FOR m = 1 TO 69

OUT &H3C8, m
OUT &H3C9, fr(m)
OUT &H3C9, fg(m)
OUT &H3C9, fb(m)
r(m) = fr(m)
g(m) = fg(m)
b(m) = fb(m)
NEXT m

pal "intro.pal", 1, r(), g(), b()

REM ------------------------
fadefromcolor2 70, 120, 360, 0, 0, 63
s = 0

' Tha teliosei pote??? We have a cross to bare...
asd% = 1
LOOP

' Ontos! Den yparxei end! I teleftaia entoli einai LOOP...

REM $STATIC
SUB fadefromcolor (a, c, t, r, g, b)

FOR s = 1 TO t
FOR k = a TO c
OUT &H3C8, k
OUT &H3C9, r + s * ((r(k) - r) / t)
OUT &H3C9, g + s * ((g(k) - g) / t)
OUT &H3C9, b + s * ((b(k) - b) / t)
NEXT k

WHILE INKEY$ <> "": END: WEND
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
NEXT s

END SUB

SUB fadefromcolor2 (a, c, t, r, g, b)
SHARED rs, sm, mc

DIM s(254)
DO

FOR k = a TO a + j + 1
s(k) = s(k) + 1
OUT &H3C8, k
OUT &H3C9, r + s(k) * ((r(k) - r) / t)
OUT &H3C9, g + s(k) * ((g(k) - g) / t)
OUT &H3C9, b + s(k) * ((b(k) - b) / t)
NEXT k
j = j + .1

IF t <> 500 THEN GOTO 501
FOR kk = 121 TO 130
s(kk) = s(kk) + 1
OUT &H3C8, kk
OUT &H3C9, 63 + s(kk) * ((r(kk) - 63) / (t + 350))
OUT &H3C9, 63 + s(kk) * ((g(kk) - 63) / (t + 350))
OUT &H3C9, 63 + s(kk) * ((b(kk) - 63) / (t + 350))
NEXT kk

501


WAIT &H3DA, 8: WAIT &H3DA, 8, 8
IF t <> 500 THEN GOTO 17
IF j < 40 THEN GOTO 17
s = s + 1
FOR l = 1 TO 69
OUT &H3C8, l
OUT &H3C9, 2 + s * ((r(l) - 2) / 2000)
OUT &H3C9, 2 + s * ((g(l) - 2) / 2000)
OUT &H3C9, 2 + s * ((b(l) - 2) / 2000)
NEXT l


17
FOR l = 150 TO 160
OUT &H3C8, l
OUT &H3C9, INT(RND * 63)
OUT &H3C9, INT(RND * 63)
OUT &H3C9, INT(RND * 63)
NEXT l

ax = INT(RND * 16)
IF ax <= 2 THEN PUT (125, 103), ax1%, PSET
IF ax > 2 AND ax <= 4 THEN PUT (125, 103), ax2%, PSET
IF ax = 5 THEN PUT (125, 103), ax3%, PSET

IF rm = 2 AND mc = 5 THEN GOTO 34
IF rm = 1 OR sm = 1 OR rm = 2 AND mc <> 5 THEN GOTO 35

dx = INT(RND * 16)
IF dx <= 3 THEN PUT (163, 106), dx1%, PSET
IF dx > 3 AND d <= 5 THEN PUT (163, 106), dx2%, PSET
ms = INT(RND * 58)
IF ms <= 3 THEN PUT (173, 99), mn1%, PSET
IF ms > 3 AND ms <= 8 THEN PUT (173, 99), mn2%, PSET
IF ms > 8 AND ms <= 15 THEN PUT (173, 99), mn3%, PSET
IF ms > 15 AND ms <= 20 THEN PUT (173, 99), mn4%, PSET
GOTO 35
34
um = INT(RND * 16)

IF um <= 4 THEN PUT (163, 92), dxm1%, PSET
IF um > 4 AND um <= 8 THEN PUT (163, 92), dxm2%, PSET
IF um > 8 AND um <= 12 THEN PUT (163, 92), dxm3%, PSET
35
REM ================ mouse ===================

IF rm = 1 THEN GOTO 41
IF sm = 1 THEN GOTO 40
rm = INT(RND * 10)
IF rm = 1 AND mc <> 5 THEN mc = 1
IF rm = 1 AND mc = 5 THEN sm = 1: rm = 0: mc = 6: PUT (163, 92), b4%, PSET
40
IF sm = 1 THEN mc = mc - 2
IF sm = 1 AND mc = 0 THEN sm = 0: rm = 0: PUT (163, 92), b4%, PSET




41
IF mc = 4 THEN PUT (163, 92), dx04%, PSET: mc = mc + 1
IF mc = 3 THEN PUT (163, 92), dx03%, PSET: mc = mc + 1
IF mc = 2 THEN PUT (163, 92), dx02%, PSET: mc = mc + 1
IF mc = 1 THEN PUT (163, 92), dx01%, PSET: mc = mc + 1
IF mc = 5 THEN rm = 2

WHILE INKEY$ <> "": END: WEND

LOOP UNTIL k = c + 34

END SUB

SUB fadefromcolorscale (a, c, t, r, g, b)

FOR s = 1 TO t
FOR k = a TO c
mo = (r(k) \ 1.5 + g(k) + b(k) \ 2) \ 2.16
OUT &H3C8, k
OUT &H3C9, (r * mo) \ 63 + s * ((r(k) - (r * mo) \ 63) / t)
OUT &H3C9, (g * mo) \ 63 + s * ((g(k) - (g * mo) \ 63) / t)
OUT &H3C9, (b * mo) \ 63 + s * ((b(k) - (b * mo) \ 63) / t)
NEXT k
WAIT &H3DA, 8: WAIT &H3DA, 8, 8

NEXT s

END SUB

SUB fadetocolor (a, c, t, r, g, b)
SHARED rs, sm, mc

DIM rr(256), gg(256), bb(256)

FOR s = 1 TO t
FOR k = a TO c
OUT &H3C8, k
OUT &H3C9, r(k) + s * ((r - r(k)) / t)
OUT &H3C9, g(k) + s * ((g - g(k)) / t)
OUT &H3C9, b(k) + s * ((b - b(k)) / t)
NEXT k
IF t <> 1000 THEN GOTO 18

FOR m = 1 TO 69
OUT &H3C7, m
rr(m) = INP(&H3C9)
gg(m) = INP(&H3C9)
bb(m) = INP(&H3C9)
NEXT m

FOR l = 1 TO 69
OUT &H3C8, l
OUT &H3C9, rr(l) + s * ((r(l) - rr(l)) / 10000)
OUT &H3C9, gg(l) + s * ((g(l) - gg(l)) / 10000)
OUT &H3C9, bb(l) + s * ((b(l) - bb(l)) / 10000)
NEXT l

FOR l = 150 TO 160
OUT &H3C8, l
OUT &H3C9, INT(RND * 63)
OUT &H3C9, INT(RND * 63)
OUT &H3C9, INT(RND * 63)
NEXT l

ax = INT(RND * 16)
IF ax <= 2 THEN PUT (125, 103), ax1%, PSET
IF ax > 2 AND ax <= 4 THEN PUT (125, 103), ax2%, PSET
IF ax = 5 THEN PUT (125, 103), ax3%, PSET

IF rm = 2 AND mc = 5 THEN GOTO 36
IF rm = 1 OR sm = 1 OR rm = 2 AND mc <> 5 THEN GOTO 37

dx = INT(RND * 16)
IF dx <= 3 THEN PUT (163, 106), dx1%, PSET
IF dx > 3 AND d <= 5 THEN PUT (163, 106), dx2%, PSET
ms = INT(RND * 28)
IF ms <= 3 THEN PUT (173, 99), mn1%, PSET
IF ms > 3 AND ms <= 8 THEN PUT (173, 99), mn2%, PSET
IF ms > 8 AND ms <= 13 THEN PUT (173, 99), mn3%, PSET
IF ms > 13 THEN PUT (173, 99), mn4%, PSET
GOTO 37
36
um = INT(RND * 16)

IF um <= 4 THEN PUT (163, 92), dxm1%, PSET
IF um > 4 AND um <= 8 THEN PUT (163, 92), dxm2%, PSET
IF um > 8 AND um <= 12 THEN PUT (163, 92), dxm3%, PSET

37

REM ================ mouse ===================

IF rm = 1 THEN GOTO 39
IF sm = 1 THEN GOTO 38
rm = INT(RND * 10)
IF rm = 1 AND mc <> 5 THEN mc = 1
IF rm = 1 AND mc = 5 THEN sm = 1: rm = 0: mc = 6: PUT (163, 92), b4%, PSET
38
IF sm = 1 THEN mc = mc - 2
IF sm = 1 AND mc = 0 THEN sm = 0: rm = 0: PUT (163, 92), b4%, PSET




39
IF mc = 4 THEN PUT (163, 92), dx04%, PSET: mc = mc + 1
IF mc = 3 THEN PUT (163, 92), dx03%, PSET: mc = mc + 1
IF mc = 2 THEN PUT (163, 92), dx02%, PSET: mc = mc + 1
IF mc = 1 THEN PUT (163, 92), dx01%, PSET: mc = mc + 1
IF mc = 5 THEN rm = 2

18

WHILE INKEY$ <> "": END: WEND
WAIT &H3DA, 8: WAIT &H3DA, 8, 8

NEXT s
END SUB

SUB fadetocolorscale (a, c, t, r, g, b)

FOR s = 1 TO t
FOR k = a TO c
mo = (r(k) \ 1.5 + g(k) + b(k) \ 2) \ 2.16
OUT &H3C8, k
OUT &H3C9, r(k) + s * (((r * mo) \ 63 - r(k)) / t)
OUT &H3C9, g(k) + s * (((g * mo) \ 63 - g(k)) / t)
OUT &H3C9, b(k) + s * (((b * mo) \ 63 - b(k)) / t)
NEXT k
WAIT &H3DA, 8: WAIT &H3DA, 8, 8

NEXT s

END SUB

SUB fill (xa, ya, xb, yb, ca, cb, a, b, c, k, l, m)

FOR y = ya TO yb
FOR x = xa TO xb
IF l = 1 THEN GOTO 78
IF POINT(x - 1, y) = 0 THEN GOTO 77
IF POINT(x + 1, y) = 0 THEN GOTO 77
IF POINT(x, y - 1) = 0 THEN GOTO 77
IF POINT(x, y + 1) = 0 THEN GOTO 77

78
IF l = 1 THEN IF POINT(x, y) <> m THEN GOTO 77

IF k = 1 THEN a = (ca - cb) / (xa - xb)
IF k = 2 THEN b = (ca - cb) / (ya - yb)
IF k <> 0 THEN c = ca - (xa * a) * (2 - k) - (ya * b) * (k - 1)


cl = (a * x + b * y + c)
PRESET (x, y), cl
77
NEXT x
NEXT y

END SUB

SUB fill2 (xa, ya, xb, yb, a, b, c)

FOR y = ya TO yb
FOR x = xa TO xb
IF POINT(x, y) <> 0 THEN GOTO 88
cl = a * x + b * y + c
PRESET (x, y), cl
88
NEXT x
NEXT y

END SUB

SUB fontget (xg, yg, l, lt%())
xf = xg \ l
yf = yg


FOR n = 0 TO l - 1
GET (xf * n + 1, 1)-(xf * (n + 1), yf), lt%(n * ((xf * yf) \ 2 + 3))
NEXT n

END SUB

SUB fontload (a$)
SHARED xg, yg, l
l$ = " ": xg$ = " ": yg$ = " ": c$ = " "
OPEN a$ FOR BINARY AS #1
GET #1, 1, l$
l = ASC(l$)
GET #1, 2, xg$
xg = ASC(xg$)
GET #1, 3, yg$
yg = ASC(yg$)

DIM c(xg, yg)

FOR y = 1 TO yg
FOR x = 1 TO xg
po = po + 1
GET #1, 3 + po, c$
c(x, y) = ASC(c$)
NEXT x
NEXT y
CLOSE
FOR y = 1 TO yg
FOR x = 1 TO xg
PRESET (x, y), c(x, y)
NEXT x
NEXT y

END SUB

SUB gradientx (xa, ya, xb, yb, ca, cb)
FOR y = ya TO yb
LINE (xa, y)-(xb, y), ca + ((cb - ca) / (yb - ya)) * (y - ya)
NEXT y
END SUB

SUB gradienty (xa, ya, xb, yb, ca, cb)

FOR x = xa TO xb
LINE (x, ya)-(x, yb), ca + ((cb - ca) / (xb - xa)) * (x - xa)
NEXT x

END SUB

SUB img (a$, c)
SHARED xg, yg

IF c = 3 THEN GOTO 3 ELSE IF c = 2 THEN GOTO 2 ELSE


REM --------- BITMAP ----------

OPEN a$ FOR BINARY AS #1

GET #1, 1, a$
xg = ASC(a$)

GET #1, 2, a$
yg = ASC(a$)

DIM c(xg, yg)

FOR y = 1 TO yg
FOR x = 1 TO xg
po = po + 1
GET #1, 2 + po, a$
c(x, y) = ASC(a$)
NEXT x
NEXT y
CLOSE


GOTO 4


2 REM ---------  RLE  ----------


OPEN a$ FOR BINARY AS #1

a$ = " "
b$ = " "

y = 1

GET #1, 1, a$
xg = ASC(a$)
GET #1, 2, b$
yg = ASC(b$)

DIM c(xg, yg)
po = 2

DO


po = po + 1
GET #1, po, a$
a = ASC(a$)
IF a = 255 AND rle = 0 THEN rle = 1: GOTO 42 ELSE IF a = 255 THEN rle = 0: GOTO 42
IF a < 255 AND rle = 0 THEN x = x + 1: IF x > xg THEN x = 1: y = y + 1
IF a < 255 AND rle = 0 THEN c(x, y) = a: GOTO 42

IF a < 255 AND rle = 1 THEN n = a: po = po + 1: GET #1, po, a$: c = ASC(a$)

FOR k = 1 TO n
x = x + 1: IF x > xg THEN x = 1: y = y + 1
c(x, y) = c
NEXT k

42
LOOP UNTIL x = xg AND y = yg

CLOSE


GOTO 4


3 REM ----------- 1bit image ------------


b$ = " ": c$ = " "

OPEN a$ FOR BINARY AS #1

y = 1
j = 8

GET #1, 1, a$
xg = ASC(a$)
GET #1, 2, b$
yg = ASC(b$)

REDIM c(xg, yg)

FOR k = 1 TO xg * yg STEP 8
pb = 128
po = po + 1
GET #1, 2 + po, c$
bb = ASC(c$)

IF xg * yg - (xg * (y - 1) + x) < 8 THEN j = xg * yg - (xg * (y - 1) + x): pb = 128

FOR l = 1 TO j
x = x + 1: IF x = xg + 1 THEN x = 1: y = y + 1
IF bb >= pb THEN c(x, y) = 15: bb = bb - pb ELSE c(x, y) = 0
pb = pb / 2
NEXT l

NEXT k

CLOSE
GOTO 4






4
FOR y = 1 TO yg
FOR x = 1 TO xg
PRESET (x, y), c(x, y)
NEXT x
NEXT y

END SUB

SUB ldiload (a$)

DIM x(1000): DIM y(1000): DIM nv(1000): DIM c(1000)
DIM px(1000): DIM py(1000): DIM pc(1000)
DIM cx(1000): DIM cy(1000): DIM cc(1000): DIM ck(1000)


OPEN a$ FOR BINARY AS #1
GET #1, 1, a$
a = ASC(a$)
GET #1, 2, a$
b = ASC(a$)
v = a * 256 + b
GET #1, 3, a$
cr = ASC(a$)
GET #1, 4, a$
p = ASC(a$)
po = 4

FOR n = 1 TO v
po = po + 1
GET #1, po, a$
IF ASC(a$) = 0 THEN po = po + 1: GET #1, po, a$: x(n) = ASC(a$) + 255 ELSE x(n) = ASC(a$)
po = po + 1
GET #1, po, a$: y(n) = ASC(a$): po = po + 1
GET #1, po, a$: c(n) = ASC(a$): po = po + 1
GET #1, po, a$: nv(n) = ASC(a$)
NEXT n

FOR n = 1 TO cr
po = po + 1
GET #1, po, a$
IF ASC(a$) = 0 THEN po = po + 1: GET #1, po, a$: cx(n) = ASC(a$) + 255 ELSE cx(n) = ASC(a$)
po = po + 1
GET #1, po, a$: cy(n) = ASC(a$): po = po + 1
GET #1, po, a$: ck(n) = ASC(a$): po = po + 1
GET #1, po, a$: cc(n) = ASC(a$)
NEXT n



FOR n = 1 TO p
po = po + 1
GET #1, po, a$
IF ASC(a$) = 0 THEN po = po + 1: GET #1, po, a$: px(n) = ASC(a$) + 255 ELSE px(n) = ASC(a$)
po = po + 1

GET #1, po, a$: py(n) = ASC(a$): po = po + 1
GET #1, po, a$: pc(n) = ASC(a$)
NEXT n
CLOSE






REM -------------------------------

FOR n = 1 TO v
IF nv(n) = 1 THEN GOTO 13
LINE (x(n - 1), y(n - 1))-(x(n), y(n)), 15
13
NEXT n

FOR n = 1 TO cr
CIRCLE (cx(n), cy(n)), ck(n), 15
NEXT n

FOR np = 1 TO p
PAINT (px(np), py(np)), pc(np), 15
NEXT np

FOR n = 1 TO v
IF nv(n) = 1 THEN GOTO 12
LINE (x(n - 1), y(n - 1))-(x(n), y(n)), c(n)
12
NEXT n

FOR n = 1 TO cr
CIRCLE (cx(n), cy(n)), ck(n), cc(n)
NEXT n

END SUB

SUB onebitfontload (a$)
SHARED xg, yg, l, ytrewq%
SCREEN 13
l$ = " ": xg$ = " ": yg$ = " ": c$ = " ": k$ = " "

OPEN a$ FOR BINARY AS #1
y = 1
j = 8

GET #1, 1, k$: IF ASC(k$) = 0 THEN k = 1

GET #1, 1 + k, l$
l = ASC(l$)

GET #1, 2 + k, xg$
IF k = 1 THEN xg = 255 + ASC(xg$) ELSE xg = ASC(xg$)

GET #1, 3 + k, yg$
yg = ASC(yg$)
po = 3 + k


CLS
FOR k = 1 TO xg * yg STEP 8
pb = 128
po = po + 1
GET #1, po, c$
bb = ASC(c$)

IF xg * yg - (xg * (y - 1) + x) < 8 THEN j = xg * yg - (xg * (y - 1) + x): pb = 128

FOR ll = 1 TO j
x = x + 1: IF x = xg + 1 THEN x = 1: y = y + 1
IF bb >= pb THEN PSET (x - 1 + ytrewq%, y - 1 + ytrewq%), 255: bb = bb - pb ELSE PSET (x - 1 + ytrewq%, y - 1 + ytrewq%), 0
pb = pb / 2
NEXT ll

NEXT k


' ============== Ultimate Baloma! ================

DIM qwerty(4, 4)
qwerty(1, 0) = 255: qwerty(2, 0) = 255
qwerty(3, 1) = 255
qwerty(2, 2) = 255
qwerty(2, 4) = 255

FOR y% = 0 TO 4
FOR x% = 0 TO 4
PSET (x% + 220, y%), qwerty(x%, y%)
NEXT x%
NEXT y%

' Ultimate balomata kai balomata pano sta balomata! Ante kane meta afton ton kodika repair ;P
' mou vgeike i pisti, ti einai aft! paraligo na spaso to mixanima....
' Umf

CLOSE


END SUB

SUB pal (a$, w, r(), g(), b())





DIM ca(100), cb(100), ba(100), ga(100), ra(100), bb(100), gb(100), rb(100), zb(100), zg(100), zr(100), cc(100)

OPEN a$ FOR BINARY AS #1
GET #1, 1, a$
k = ASC(a$)

FOR a = 1 TO k
GET #1, a + 1 + (a - 1) * 3, a$
cc(a) = ASC(a$)
GET #1, a + 2 + (a - 1) * 3, a$
zb(a) = ASC(a$)
GET #1, a + 3 + (a - 1) * 3, a$
zg(a) = ASC(a$)
GET #1, a + 4 + (a - 1) * 3, a$
zr(a) = ASC(a$)
NEXT a

q = k + 4 + (k - 1) * 3


GET #1, q + 1, a$
n = ASC(a$)

FOR a = 1 TO n
GET #1, q + 1 + a + (a - 1) * 7, a$
ca(a) = ASC(a$)
GET #1, q + 1 + a + 1 + (a - 1) * 7, a$
cb(a) = ASC(a$)
GET #1, q + 1 + a + 2 + (a - 1) * 7, a$
ba(a) = ASC(a$)
GET #1, q + 1 + a + 3 + (a - 1) * 7, a$
ga(a) = ASC(a$)
GET #1, q + 1 + a + 4 + (a - 1) * 7, a$
ra(a) = ASC(a$)
GET #1, q + 1 + a + 5 + (a - 1) * 7, a$
bb(a) = ASC(a$)
GET #1, q + 1 + a + 6 + (a - 1) * 7, a$
gb(a) = ASC(a$)
GET #1, q + 1 + a + 7 + (a - 1) * 7, a$
rb(a) = ASC(a$)
NEXT a
CLOSE

FOR m = 1 TO k

IF w = 1 THEN r(cc(m)) = zr(m): g(cc(m)) = zg(m): b(cc(m)) = zb(m): GOTO 15

OUT &H3C8, cc(m)
OUT &H3C9, zr(m)
OUT &H3C9, zg(m)
OUT &H3C9, zb(m)
15
NEXT m

FOR v = 1 TO n

FOR l = ca(v) TO cb(v)
bb = ba(v) + (l - ca(v)) * ((bb(v) - ba(v)) / (cb(v) - ca(v)))
gg = ga(v) + (l - ca(v)) * ((gb(v) - ga(v)) / (cb(v) - ca(v)))
rr = ra(v) + (l - ca(v)) * ((rb(v) - ra(v)) / (cb(v) - ca(v)))

IF w = 1 THEN r(l) = rr: g(l) = gg: b(l) = bb: GOTO 16
OUT &H3C8, l
OUT &H3C9, INT(rr)
OUT &H3C9, INT(gg)
OUT &H3C9, INT(bb)
16

NEXT l
NEXT v

REM FOR x = 0 TO 255
REM LINE (x + 40, 200)-(x + 40, 180), x
REM NEXT x
END SUB

SUB pal0 (a$)
DIM ri(255), gi(255), bi(255)

r$ = " ": g$ = " ": b$ = " "


OPEN a$ FOR BINARY AS #1

FOR k = 0 TO 255

GET #1, 1 + l, r$
ri(k) = ASC(r$)
GET #1, 2 + l, g$
gi(k) = ASC(g$)
GET #1, 3 + l, b$
bi(k) = ASC(b$)
l = l + 3
NEXT k
CLOSE

FOR k = 0 TO 255

OUT &H3C8, k
OUT &H3C9, ri(k)
OUT &H3C9, gi(k)
OUT &H3C9, bi(k)

NEXT k

END SUB

SUB palget (r(), g(), b())

FOR k = 0 TO 255
OUT &H3C7, k
r(k) = INP(&H3C9)
g(k) = INP(&H3C9)
b(k) = INP(&H3C9)
NEXT k

END SUB

SUB text (a$, xf, yf)
FOR n = 1 TO LEN(a$)
n$ = MID$(a$, n, 1)
IF n$ = " " THEN GOTO 1
PUT (n * xf + n * 2 - (264 * xx), yf * yy + 4 * yy), lt%((ASC(n$) - 65) * ((xf * yf) \ 2 + 3)), PSET
1
IF (n * xf + n * 2 - (264 * xx)) >= 264 THEN yy = yy + 1: xx = xx + 1
NEXT n

END SUB

